home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops source / Asm Source / parser < prev    next >
Text File  |  1994-05-08  |  5KB  |  221 lines

  1. \ Assembler            ReeseWarner            3/85
  2. \  May 87 mrh  rewritten to use code ParseToken for speed.
  3.  
  4. 0 -> dlevel
  5.  
  6. 0 value  POS        \ position on line
  7.  
  8. 0 value  LINECT
  9.  
  10. 0 value  STOREDTOKEN
  11.  
  12. 0 value  CHARCOUNT    \ char in definition
  13.  
  14. string  TOKEN
  15.  
  16.  
  17. code CHARCLASS
  18.  
  19. hex
  20. 0C00 w, 0020 w,        \    CMPI.B    #$20,DO        ; blank
  21. 6f00 w, 008c w,        \    BEQ    cntrl
  22. 0c00 w, 0041 w,        \    CMPI.B    #$41,D0        ; A
  23. 6d18 w,                \    BLT.S    trydig
  24. 0c00 w, 005a w,        \    CMPI.B    #$5A,D0        ; Z
  25. 6F00 w, 0090 w,        \    BLE    maybe
  26. 0c00 w, 0061 w,        \    CMPI.B    #$61,D0        ; a
  27. 6d18 w,            \    BLT.S    tryspec
  28. 0c00 w, 007a w,        \    CMPI.B    #$7A,D0        ; z
  29. 6f00 w, 0082 w,        \    BLE    maybe
  30. 6070 w,            \    BRA.S    spec        ; Everything above z
  31.             \                ;  is a special
  32.  
  33. 0c00 w, 0030 w,    \    trydig  CMPI.B    #$30,D0        ; 0
  34. 6d08 w,            \    BLT.S   tryspec
  35. 0c00 w, 0039 w,        \    CMPI.B    #$39,D0        ; 9
  36. 6f00 w, 006e w,        \    BLE    digit
  37. 0c00 w, 0028 w,    \    tryspec    CMPI.B    #$28,D0        ; (
  38. 6760 w,            \    BEQ.S    letter
  39. 0c00 w, 0029 w,        \    CMPI.B    #$29,D0        ; )
  40. 675a w,            \    BEQ.S    letter
  41. 0c00 w, 0024 w,        \    CMPI.B    #$24,D0        ; $
  42. 6758 w,            \    BEQ.S    dollar
  43. 0c00 w, 002d w,        \    CMPI.B  #$2D,D0        ; -
  44. 6724 w,            \    BEQ.S    minus
  45. 0c00 w, 003b w,        \    CMPI    #$3B,D0        ; ;
  46. 6748 w,            \    BEQ.S    letter
  47. 0c00 w, 002b w,        \    CMPI    #$2B,D0        ; +
  48. 6748 w,            \    BEQ.S    digit
  49. 603c w,            \    BRA.S    spec
  50.  
  51. \ *** The following is obsolete and unexecuted, but if I remove it
  52. \  it will take me weeks to fix up all the changed offsets!! ***
  53.  
  54. 005d w,            \    CMPI.B    #$5D,D0        ; ]
  55. 6738 w,            \    BEQ.S    spec
  56. 0c00 w, 005b w,        \    CMPI.B    #$5B,D0        ; [
  57. 6732 w,            \    BEQ.S    spec
  58. 0c00 w, 0024 w,        \    CMPI.B    #$24,D0        ; $
  59. 6734 w,            \    BEQ.S    dollar
  60. 0c00 w, 002d w,        \    CMPI.B    #$2D,D0        ; -
  61. 662a w,            \    BNE.S    letter
  62.  
  63. \ *** End of obsolete section.
  64.  
  65. 1210 w,        \    minus    MOVE.B    (A0),D1        ; Look at next char
  66. 0c01 w, 0028 w,        \    CMPI.B    #$28,D1        ; -(
  67. 6722 w,            \    BEQ.S    letter
  68. 2003 w,            \    MOVE.L    D3,D0        ; But if we're in a
  69. 4e75 w,            \    RTS            ; word, it's a spec,
  70.             \                ; otherwise a digit.
  71.  
  72. \ *** Another obsolete section.
  73.  
  74. 6718 w,            \    BEQ.S    spec
  75. 0c01 w, 0044 w,        \    CMPI.B    #$44,D1        ; -D
  76. 6712 w,            \    BEQ.S    spec
  77. 0c01 w, 0064 w,        \    CMPI.B    #$64,D1        ; -d
  78. 670c w,            \    BEQ.S    spec
  79. 0c01 w, 0028 w,        \    CMPI.B    #$28,D1        ; -(
  80. 670a w,            \    BEQ.S    letter
  81. 600e w,            \    BRA.S    digit
  82.  
  83. \ *** end of obsolete section.
  84.  
  85. 7003 w,        \    cntrl    MOVEQ    #3,D0
  86. 4e75 w,            \    RTS
  87.  
  88. 7002 w,        \    spec    MOVEQ    #2,D0
  89. 4e75 w,            \    RTS
  90.  
  91. 7000 w,        \    letter    MOVEQ    #0,D0
  92. 4e75 w,            \    RTS
  93.  
  94. 7401 w,        \    dollar    MOVEQ    #1,D2
  95. 7001 w,        \    digit    MOVEQ    #1,D0
  96. 4e75 w,        \    end    RTS
  97. 2002 w,        \    maybe    MOVE    D2,D0    ; "Letter" may be digit
  98. 4e75 w,            \    RTS        ; if we're reading hex
  99.  
  100.    0 w,            \ Get offsets right!
  101.  
  102. code  PARSETOKEN
  103.  
  104. 2C1E w,            \    POP    D6
  105. 6726 w,            \    BEQ.S    eol
  106. 5346 w,            \    SUBQ.W    #1,D6
  107. 7400 w,            \    MOVEQ    #0,D2
  108. 2056 w,            \    MOVE    (A6),A0
  109. 7601 w,            \    MOVEQ    #1,D3        ; Initially we want
  110.             \                ; '-' to be a digit
  111. 1018 w,            \    MOVE.B    (A0)+,D0
  112. 0C00 w, 0020 w,    \    bloop    CMPI    #$20,D0
  113. 52CE w, FFF8 w,        \    DBHI    D6,bloop
  114. 6F12 w,            \    BLE.S    eol
  115. 2248 w,            \    MOVE    A0,A1
  116. 6100 w, FF28 w,        \    BSR    dic[charclass]
  117. 4A40 w,            \    TST.W    D0
  118. 6716 w,            \    BEQ.S    word
  119. 5380 w,            \    SUBQ    #1,D0
  120. 672E w,            \    BEQ.S    number
  121. 7603 w,            \    MOVEQ    #3,D3
  122. 6046 w,            \    BRA.S
  123.  
  124. 4296 w,        \    eol    CLR    (SP)
  125. 2d3C w, 4 ,        \    PUSH    #4
  126. 42A6 w,            \    CLR    -(SP)
  127. 42A6 w,            \    CLR    -(SP)
  128. 6048 w,            \    BRA.S    end
  129.  
  130. 7602 w,        \    word    MOVEQ    #2,D3
  131. 5346 w,            \    SUBQ.W    #1,D6
  132. 6B30 w,            \    BMI.S
  133. 1018 w,        \    wdloop    MOVE.B    (A0)+,D0
  134. 6100 w, FF02 w,        \    BSR    dic[charclass]
  135. 4A40 w,            \    TST.W    D0
  136. 6702 w,            \    BEQ.S    wtest
  137. 5380 w,            \    SUBQ    #1,D0
  138. 56CE w, FFF2 w,    \    wtest    DBNE    D6,wdloop
  139. 6016 w,            \    BRA.S    eoltst
  140. 0 w,
  141. 0 w,
  142. 7601 w,        \    number    MOVEQ    #1,D3
  143. 5346 w,            \    SUBQ.W    #1,D6
  144. 6B14 w,            \    BMI.S    eol
  145. 1018 w,        \    numloop    MOVE.B    (A0)+,D0
  146. 6100 w, FEE6 w,        \    BSR    dic[charclass]
  147. 5380 w,            \    SUBQ    #1,D0
  148. 56CE w, FFF6 w,        \    DBNE    D6,numloop
  149. 6706 w,        \    endtst    BEQ.S    end
  150. 4E71 w,            \        2 NOPs resulting from patching!!
  151. 4E71 w,            \
  152. 5388 w,            \    SUBQ    #1,A0
  153. 5246 w,        \    end    ADDQ.W    #1,D6
  154. 2C86 w,            \    MOVE    D6,(SP)
  155. 2D03 w,            \    PUSH    D3
  156. 5389 w,            \    SUBQ    #1,A1
  157. 2209 w,            \    MOVE    A1,D1
  158. 4e71 w, \ 93CB w,    \    SUB    A3,A1 -> NOP
  159. 2D09 w,            \    PUSH    A1
  160. 91C1 w,            \    SUB    D1,A0
  161. 2D08 w,            \    PUSH    A0
  162. 4e75 w,            \    RTS
  163.  
  164. decimal
  165.  
  166. false    value    LABEL_THERE?    \ Set true if this line has a token at the
  167.                 \  start - i.e. a label.  Used by main loop.
  168.  
  169. : GETLINE  { \ #chars ch -- }
  170.     msg" getLine called"
  171.     (Frefill)  0= ?error 154        \ Premature end of file
  172.     bytesRead: topFile  ++> charCount    \ May be different to #TIB @
  173.     #tib @  -> #chars
  174.     0 -> pos
  175.     1 ++> linect
  176.     #chars
  177.     IF
  178.         tib c@  -> ch
  179.         ch bl =
  180.         IF  false
  181.         ELSE    ch & ; =
  182.             IF  false
  183.             ELSE    ch & \ =  IF  false  ELSE  true  THEN
  184.             THEN
  185.         THEN
  186.     ELSE
  187.         false
  188.     THEN
  189.     -> label_there?  ;
  190.  
  191.  
  192. : RestOfLine        \ ( -- addr len )
  193.     tib pos +  #tib @ pos -  ;
  194.  
  195.  
  196. \ NEXTTOKEN puts the token into string Token and returns one of the following
  197. \  four token types:
  198. \        number, word, special, end-of-line
  199.  
  200. : NEXTTOKEN  { \ aa bb cc dd ee -- tokenType }
  201.  
  202. \ Note: the locals are dummies to force regs to be saved over the
  203. \ ParseToken call!!
  204.  
  205.     clear: token
  206.     storedToken
  207.     NIF
  208.         restOfLine  parseToken  put: token
  209.         dup eol =
  210.         IF
  211.             2drop  eol
  212.         ELSE
  213.             swap ( # chars left )  #tib @  over -  -> pos
  214.             NIF  eol -> storedToken  THEN
  215.         THEN
  216.     ELSE
  217.         storedToken
  218.         0 -> storedToken
  219.     THEN
  220.     uc: token  2drop  ;
  221.